home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf / GFA.Anwendung / KALENDER.LST < prev    next >
File List  |  1992-09-14  |  5KB  |  161 lines
  1. REM  *********************************
  2. REM  *        Kalender V 1.0         *
  3. REM  *     © 1992 by Henry König     *
  4. REM  * Bornheide 71, 2000 Hamburg 53 *
  5. REM  *********************************
  6. init
  7. programmkopf
  8. jahr%=0
  9. WHILE jahr%<1900 OR jahr%>2000
  10.   PRINT AT(4,10);"Kalender von welchem Jahr: ";
  11.   INPUT jahr$
  12.   jahr%=VAL(jahr$)
  13. WEND
  14. PRINT
  15. INPUT "    Ausgabe auf den Drucker j/n ";x$
  16. IF UPPER$(x$)="J" THEN
  17.   gadr%=4
  18. ENDIF
  19. DIM motage%(12)
  20. DIM tag$(7)
  21. DIM ewt%(12)
  22. DIM uebers$(4)
  23. uebers$(1)="Januar            Februar         März"
  24. uebers$(2)="April             Mai             Juni"
  25. uebers$(3)="Juli              August          September"
  26. uebers$(4)="Oktober           November        Dezember"
  27. FOR monat%=1 TO 12
  28.   READ motage%(monat%)
  29. NEXT monat%
  30. IF jahr%/4=INT(jahr%/4) THEN
  31.   motage%(2)=29                  !  ist ein Schaltjahr
  32. ENDIF
  33. FOR i%=1 TO 7
  34.   READ tag$(i%)
  35. NEXT i%
  36. REM Wochentag des 1.1. berechnen
  37. tage=INT(0.98+365.25*(jahr%-1900))
  38. ewt%(1)=tage-INT((tage-1)/7)*7
  39. REM Wochentag von jeden Monat berechnen
  40. FOR monat%=2 TO 12
  41.   sum=ewt%(monat%-1)+motage%(monat%-1)
  42.   ewt%(monat%)=sum-INT((sum-1)/7)*7
  43. NEXT monat%
  44. REM Kalender ausgeben
  45. CLS
  46. PRINT SPC(25);"Kalender ";jahr%
  47. PRINT
  48. IF gadr%=4 THEN                !  Druckerausgabe
  49.   OPEN "O",#4,"PRT:"             !  Drucker öffnen
  50.   PRINT #4,SPC(25);"Kalender ";jahr%
  51.   PRINT #4,
  52. ENDIF
  53. FOR mreihe%=1 TO 4
  54.   PRINT
  55.   PRINT
  56.   PRINT SPC(8);uebers$(mreihe%)
  57.   PRINT
  58.   IF gadr%=4 THEN
  59.     PRINT #4,
  60.     PRINT #4,
  61.     PRINT #4,SPC(8);uebers$(mreihe%)
  62.     PRINT #4,
  63.   ENDIF
  64.   FOR reihe%=1 TO 7
  65.     PRINT tag$(reihe%);
  66.     IF gadr%=4 THEN
  67.       PRINT #4,tag$(reihe%);
  68.     ENDIF
  69.     FOR mspalte=1 TO 3
  70.       monat%=3*(mreihe%-1)+mspalte
  71.       FOR spalte=1 TO 6
  72.         dat=spalte*7-6+reihe%-ewt%(monat%)
  73.         IF dat<=0 OR dat>motage%(monat%) THEN
  74.           dat$="   "                     !  Datum negativ
  75.         ELSE
  76.           dat$=RIGHT$("   "+STR$(dat),3)
  77.         ENDIF
  78.         PRINT dat$;
  79.         IF gadr%=4 THEN
  80.           PRINT #4,dat$;
  81.         ENDIF
  82.       NEXT spalte
  83.     NEXT mspalte
  84.     PRINT
  85.     IF gadr%=4 THEN
  86.       PRINT #4,
  87.     ENDIF
  88.   NEXT reihe%
  89. NEXT mreihe%
  90. CLOSE #4
  91. PRINT
  92. PRINT SPC(20);"Ende mit beliebiger Taste";
  93. INPUT x$
  94. CLOSEW #1
  95. CLOSES 1
  96. END
  97. REM Anzahl der Tage je Monat
  98. DATA 31,28,31,30,31,30,31,31,30,31,30,31
  99. REM Kurzform der Wochentage
  100. DATA "Mo","Di","Mi","Do","Fr","Sa","So"
  101. PROCEDURE programmkopf
  102.   CLS                           ! Bildschirm löschen
  103.   COLOR 2                       ! schwarz
  104.   PBOX 1,1,639,22               ! Box zeichnen
  105.   COLOR 0                       ! grau
  106.   PBOX 4,3,636,20               ! Box zeichnen
  107.   COLOR 4                       ! hellgrau
  108.   LINE 8,18,632,18              ! untere Lichtlinien
  109.   LINE 632,4,632,18             ! rechte Lichtlinie
  110.   LINE 631,5,631,18             ! rechte Lichtlinie
  111.   COLOR 2                       ! schwarz
  112.   LINE 8,4,631,4                ! obere Schatttenlinie
  113.   LINE 6,4,6,18                 ! linke Schattenlinie
  114.   LINE 7,4,7,17                 ! linke Schattenlinie
  115.   PCOLOR 5,0                    ! gelbe Schrift
  116.   PRINT AT(28,2);"K a l e n d e r  1.00"
  117.   PCOLOR 1,0                    ! weiße Schrift
  118.   programmfuss
  119.   PRINT AT(4,28);"© 1992 by Henry König, Bornheide 71, 2000 Hamburg 53"
  120. RETURN
  121. > PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  122. COLOR 2                       ! schwarz
  123. PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  124. COLOR 0                       ! grau
  125. PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  126. PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  127. COLOR 4                       ! hellgrau
  128. BOX 7,(27*8)-7,633,(32*8)-3
  129. LINE 7,(29*8)+2,633,(29*8)+2
  130. LINE 16,(29*8)-6,639-16,(29*8)-6
  131. LINE 16,(29*8)+5,639-16,(29*8)+5
  132. LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  133. LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  134. COLOR 2                       ! schwarz
  135. LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  136. LINE 633,(27*8)-7,633,(32*8)-3
  137. LINE 16,(27*8)-4,639-16,(27*8)-4
  138. LINE 16,(31*8)+2,639-16,(31*8)+2
  139. LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  140. LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
  141. RETURN
  142. > PROCEDURE init
  143. breite%=640                   ! Screenbreite
  144. hoehe%=256                    ! Screenhöhe
  145. ebenen%=3                     ! 3 Bitplanes
  146. OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  147. OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  148. farben.setzen                 ! Farbpalette setzen
  149. RETURN
  150. > PROCEDURE farben.setzen
  151. SETCOLOR 0,5,5,5              ! grau statt blau
  152. SETCOLOR 1,15,15,15           ! weiß bleibt
  153. SETCOLOR 2,0,0,0              ! schwarz erhalten
  154. SETCOLOR 3,15,5,0             ! rot bleibt
  155. SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  156. SETCOLOR 5,15,15,0            ! gelb
  157. SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
  158. RETURN
  159. REM
  160. REM
  161.